Ham Radio 2000 #1/Ham Radio 2000.iso/ham2000/packet/p_aa4re/bb212src/bbcmf.pas

Pascal/Delphi Source File | 1992-02-16 | 10.8 KB | 330 lines

(*===========================================================================*)
(* Change msg flag command                                                   *)
(*                                                                           *)
(*   Copyright 1991 by H. Roy Engehausen.  All rights reserved.              *)
(*                                                                           *)
(*===========================================================================*)

{$O+}

UNIT BBCMF;

INTERFACE

USES
  bbdummy;

PROCEDURE change_status_cmd(cmd_string : STRING);

CONST
  change_status_list : STRING[15] = 'HOLD REL UNKILL';

IMPLEMENTATION

USES
  CRT,
  bblog,
  bbmdata,
  bbmess,
  bbmisc,
  bbmf,
  bbmmsgn,
  bbsearch,
  bbstr;

{$UNDEF debug}

(*===========================================================================*)
(* Change a specific message                                                 *)
(*===========================================================================*)

PROCEDURE change_a_msg(m_ptr : msg_index_ptr;
                       and_mask : msg_flag_type;
                       or_mask  : msg_flag_type;
                       tell_sw  : BOOLEAN);
  BEGIN;

    WITH m_ptr^.msg_i_mb DO
      BEGIN;

        (*-------------------------------------------------------------------*)
        (* Set flag and update the message file                              *)
        (*-------------------------------------------------------------------*)

        msg_flag := (msg_flag AND and_mask) OR or_mask;

        update_msg(m_ptr);

        (*-------------------------------------------------------------------*)
        (* Tell user if he wants to know about it                            *)
        (*-------------------------------------------------------------------*)

        IF NOT tell_sw THEN
          EXIT;

        active_tcb^.curr_msg := m_ptr^;

        send_message(message_flag_change);

        (*-------------------------------------------------------------------*)
        (* Update routing pointer as needed                                  *)
        (*-------------------------------------------------------------------*)

        IF msg_route_num > msg_number THEN
          msg_route_num := msg_number;

      END;

  END;

(*===========================================================================*)
(* Change a group of messages                                                *)
(*===========================================================================*)

PROCEDURE change_msg_group(VAR cmd_string : STRING;
                                 and_mask : msg_flag_type;
                                 or_mask  : msg_flag_type);

  VAR
    b            : BOOLEAN;
    i_ptr        : msg_index_ptr;
    search_block : search_block_type;
    change_char  : CHAR;
    c_msg_no     : LONGINT;
    ok_to_change : BOOLEAN;
    word_count   : BYTE;

  (*=========================================================================*)
  (* Put change error message out                                            *)
  (*=========================================================================*)

  PROCEDURE put_change_error(err_num : BYTE);

    VAR
      err_string : STRING[6];

    BEGIN;

      WITH active_tcb^ DO
        BEGIN;

          STR(c_msg_no, err_string);

          set_dollar1_parm(@err_string);
          send_message(err_num);

          error_sw     := TRUE;
          ok_to_change := FALSE;

        END;

    END;

  (*=========================================================================*)
  (* Change command main line                                                *)
  (*=========================================================================*)

  BEGIN;

    log_data_s('L' + cmd_string);

    word_count := WORDS(cmd_string);

    change_char := UPCASE(cmd_string[2]);

    (*-----------------------------------------------------------------------*)
    (* Handle change                                                         *)
    (*-----------------------------------------------------------------------*)

    CASE change_char OF

      (*---------------------------------------------------------------------*)
      (* Change ' '                                                          *)
      (*---------------------------------------------------------------------*)

      ' ': BEGIN;

             (*--------------------------------------------------------------*)
             (* Check count                                                  *)
             (*--------------------------------------------------------------*)

             IF word_count < 2 THEN
               BEGIN;
                 send_message(message_not_en);
                 active_tcb^.error_sw :=TRUE;
                 EXIT;
               END;

             (*--------------------------------------------------------------*)
             (* Validate number                                              *)
             (*--------------------------------------------------------------*)

             upcase_str_var(cmd_string);

             check_multiple_msg(@cmd_string, 2, word_count);
             IF active_tcb^.error_sw THEN
               EXIT;

             (*--------------------------------------------------------------*)
             (* Loop thru all the messages                                   *)
             (*--------------------------------------------------------------*)

             c_msg_no := get_next_multiple_msg;

             WHILE c_msg_no <> 0 DO
               BEGIN;

                 (*----------------------------------------------------------*)
                 (* Ready to change                                          *)
                 (*----------------------------------------------------------*)

                 ok_to_change := TRUE;

                 (*----------------------------------------------------------*)
                 (* Find message,  Give error if cannot be found             *)
                 (*----------------------------------------------------------*)

                 i_ptr := find_msg(c_msg_no);

                 IF i_ptr = NIL THEN
                   BEGIN;
                     put_change_error(message_rmc_nf);
                     IF NOT in_multiple_msg_range THEN
                       EXIT;
                   END;

                 (*----------------------------------------------------------*)
                 (* If so far so good then change it                         *)
                 (*----------------------------------------------------------*)

                 IF ok_to_change THEN
                   change_a_msg(i_ptr, and_mask, or_mask, TRUE);

                 (*----------------------------------------------------------*)
                 (* Get next message to change                               *)
                 (*----------------------------------------------------------*)

                 c_msg_no := get_next_multiple_msg;

               END; (*----- End loop thru all messages ----------------------*)

           END;

      (*---------------------------------------------------------------------*)
      (* All other letters                                                   *)
      (*---------------------------------------------------------------------*)

      ELSE
        BEGIN;

          (*-----------------------------------------------------------------*)
          (* Build search block                                              *)
          (*-----------------------------------------------------------------*)

          cmd_string := COPY(cmd_string, 2, 255);
          set_search(cmd_string, @search_block);

          IF active_tcb^.error_sw THEN
            EXIT;

          (*-----------------------------------------------------------------*)
          (* Find first one                                                  *)
          (*-----------------------------------------------------------------*)

          search_msg(@search_block);

          IF search_block.search_last = NIL THEN
            BEGIN;
              send_message(message_lmc_nf);
              active_tcb^.error_sw := TRUE;
              EXIT;
            END;

          (*-----------------------------------------------------------------*)
          (* Loop changing things                                            *)
          (*-----------------------------------------------------------------*)

          REPEAT
            IF active_tcb^.error_sw THEN
              EXIT;
            change_a_msg(search_block.search_last, and_mask, or_mask, TRUE);
            search_msg(@search_block);
          UNTIL search_block.search_last = NIL;

        END;

    END;

  END;

(*===========================================================================*)
(* Change status of a message                                                *)
(*===========================================================================*)

PROCEDURE change_status_cmd(cmd_string : STRING);

  VAR
    i : msg_flag_type;
    j : BYTE;
    s : STRING[10];

  BEGIN;

    s := subword(@cmd_string, 1, 1);
    upcase_str_var(s);

    j := find(@change_status_list, @s);

    cmd_string := subword(@cmd_string, 2, 0);

    IF cmd_string = '' THEN
      BEGIN;
        send_message(message_not_en);
        active_tcb^.error_sw :=TRUE;
        EXIT;
      END;

    IF (cmd_string[1] >= '0') AND (cmd_string[1] <= '9') THEN
      cmd_string := '? ' + cmd_string
    ELSE
      cmd_string := '?' + cmd_string;

    CASE j OF

      (*---------------------------------------------------------------------*)
      (* HOLD                                                                *)
      (*---------------------------------------------------------------------*)

      1: change_msg_group(cmd_string, 0, mf_hold);

      (*---------------------------------------------------------------------*)
      (* REL                                                                 *)
      (*---------------------------------------------------------------------*)

      2: BEGIN;
           i := mf_hold + mf_review;
           change_msg_group(cmd_string, NOT i, 0);
         END;

      (*---------------------------------------------------------------------*)
      (* UNKILL                                                              *)
      (*---------------------------------------------------------------------*)

      3: BEGIN;
           i := mf_kill;
           change_msg_group(cmd_string, NOT i, 0);
         END;

      ELSE
        BEGIN;
          WRITELN ('Bad index in CMF -- ', j);
          HALT;
        END;

    END;

  END;

END.